more OsPath conversion

Finally reached Annex code in this conversion.

Sponsored-by: Graham Spencer

diff --git a/Utility/FileIO.hs b/Utility/FileIO.hs
index c40014810eb08e2906a353efad3eacce4b4e2db6..f8feb66886ef62d0bf28f27834c28c72e0fa8e85 100644 (file)
--- a/Utility/FileIO.hs
+++ b/Utility/FileIO.hs
@@ -16,6 +16,7 @@ module Utility.FileIO
 (
        withFile,
        openFile,
+       openBinaryFile,
        readFile,
        readFile',
        writeFile,
@@ -51,6 +52,11 @@ openFile f m = do
        f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
        O.openFile f' m
 
+openBinaryFile :: OsPath -> IOMode -> IO Handle
+openBinaryFile f m = do
+       f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
+       O.openBinaryFile f' m
+
 readFile :: OsPath -> IO L.ByteString
 readFile f = do
        f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
@@ -104,6 +110,9 @@ withFile = System.IO.withFile . fromRawFilePath
 openFile :: OsPath -> IOMode -> IO Handle
 openFile = System.IO.openFile . fromRawFilePath
 
+openBinaryFile :: OsPath -> IOMode -> IO Handle
+openBinaryFile = System.IO.openBinaryFile . fromRawFilePath
+
 readFile :: OsPath -> IO L.ByteString
 readFile = L.readFile . fromRawFilePath
 

diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs
index 4858b0bdff4c695bf258b6065e4635a97cfc83fc..e275771d052b15c659afdbe3bc656b91d10e1dd0 100644 (file)
--- a/Utility/FileSize.hs
+++ b/Utility/FileSize.hs
@@ -24,6 +24,7 @@ import System.PosixCompat.Files (fileSize)
 #endif
 import System.PosixCompat.Files (FileStatus)
 import qualified Utility.RawFilePath as R
+import Utility.OsPath
 
 type FileSize = Integer
 
@@ -33,18 +34,18 @@ type FileSize = Integer
  - FileOffset which maxes out at 2 gb.
  - See https://github.com/jystic/unix-compat/issues/16
  -}
-getFileSize :: R.RawFilePath -> IO FileSize
+getFileSize :: OsPath -> IO FileSize
 #ifndef mingw32_HOST_OS
-getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f)
+getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus (fromOsPath f))
 #else
-getFileSize f = bracket (F.openFile (toOsPath f) ReadMode) hClose hFileSize
+getFileSize f = bracket (F.openFile f ReadMode) hClose hFileSize
 #endif
 
 {- Gets the size of the file, when its FileStatus is already known.
  -
  - On windows, uses getFileSize. Otherwise, the FileStatus contains the
  - size, so this does not do any work. -}
-getFileSize' :: R.RawFilePath -> FileStatus -> IO FileSize
+getFileSize' :: OsPath -> FileStatus -> IO FileSize
 #ifndef mingw32_HOST_OS
 getFileSize' _ s = return $ fromIntegral $ fileSize s
 #else

diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
index 5b6098a4be98216efb1a3c3b259323e0a36d0825..29d51ce056e7e55b2207e113b86336c7312e994c 100644 (file)
--- a/Utility/Gpg.hs
+++ b/Utility/Gpg.hs
@@ -182,7 +182,7 @@ feedRead cmd params passphrase feeder reader = do
        withTmpFile (toOsPath "gpg") $ \tmpfile h -> do
                liftIO $ B.hPutStr h passphrase
                liftIO $ hClose h
-               let passphrasefile = [Param "--passphrase-file", File (fromRawFilePath (fromOsPath tmpfile))]
+               let passphrasefile = [Param "--passphrase-file", File (fromOsPath tmpfile)]
                go $ passphrasefile ++ params
 #endif
   where
@@ -441,7 +441,7 @@ testHarness tmpdir cmd a = ifM (inSearchPath (unGpgCmd cmd))
        go Nothing = return Nothing
 
         makenewdir n = do
-               let subdir = tmpdir </> show n
+               let subdir = toOsPath tmpdir </> toOsPath (show n)
                catchIOErrorType AlreadyExists (const $ makenewdir $ n + 1) $ do
                        createDirectory subdir
                        return subdir

diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs
index 6f8008dd5f06b247102a38ac3ee1a744681dac88..7e1b18aa35fd46a5c29721aa5265889fc95a851d 100644 (file)
--- a/Utility/InodeCache.hs
+++ b/Utility/InodeCache.hs
@@ -49,6 +49,7 @@ import Common
 import Utility.TimeStamp
 import Utility.QuickCheck
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 import System.PosixCompat.Types
 import System.PosixCompat.Files (isRegularFile, fileID)
@@ -189,20 +190,20 @@ readInodeCache s = case words s of
                return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t)
        _ -> Nothing
 
-genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
+genInodeCache :: OsPath -> TSDelta -> IO (Maybe InodeCache)
 genInodeCache f delta = catchDefaultIO Nothing $
-       toInodeCache delta f =<< R.getSymbolicLinkStatus f
+       toInodeCache delta f =<< R.getSymbolicLinkStatus (fromOsPath f)
 
-toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
+toInodeCache :: TSDelta -> OsPath -> FileStatus -> IO (Maybe InodeCache)
 toInodeCache d f s = toInodeCache' d f s (fileID s)
 
-toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache)
+toInodeCache' :: TSDelta -> OsPath -> FileStatus -> FileID -> IO (Maybe InodeCache)
 toInodeCache' (TSDelta getdelta) f s inode
        | isRegularFile s = do
                delta <- getdelta
                sz <- getFileSize' f s
 #ifdef mingw32_HOST_OS
-               mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f)
+               mtime <- utcTimeToPOSIXSeconds <$> getModificationTime f
 #else
                let mtime = Posix.modificationTimeHiRes s
 #endif
@@ -214,8 +215,8 @@ toInodeCache' (TSDelta getdelta) f s inode
  - Its InodeCache at the time of its creation is written to the cache file,
  - so changes can later be detected. -}
 data SentinalFile = SentinalFile
-       { sentinalFile :: RawFilePath
-       , sentinalCacheFile :: RawFilePath
+       { sentinalFile :: OsPath
+       , sentinalCacheFile :: OsPath
        }
        deriving (Show)
 
@@ -232,8 +233,8 @@ noTSDelta = TSDelta (pure 0)
 
 writeSentinalFile :: SentinalFile -> IO ()
 writeSentinalFile s = do
-       writeFile (fromRawFilePath (sentinalFile s)) ""
-       maybe noop (writeFile (fromRawFilePath (sentinalCacheFile s)) . showInodeCache)
+       F.writeFile' (sentinalFile s) mempty
+       maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache)
                =<< genInodeCache (sentinalFile s) noTSDelta
 
 data SentinalStatus = SentinalStatus
@@ -262,7 +263,7 @@ checkSentinalFile s = do
                                Just new -> return $ calc old new
   where
        loadoldcache = catchDefaultIO Nothing $
-               readInodeCache <$> readFile (fromRawFilePath (sentinalCacheFile s))
+               readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s))
        gennewcache = genInodeCache (sentinalFile s) noTSDelta
        calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) =
                SentinalStatus (not unchanged) tsdelta
@@ -287,7 +288,7 @@ checkSentinalFile s = do
        dummy = SentinalStatus True noTSDelta
 
 sentinalFileExists :: SentinalFile -> IO Bool
-sentinalFileExists s = allM R.doesPathExist [sentinalCacheFile s, sentinalFile s]
+sentinalFileExists s = allM doesPathExist [sentinalCacheFile s, sentinalFile s]
 
 instance Arbitrary InodeCache where
        arbitrary =

diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs
index 64ab78576bcdcfcc74e33fac36f381a0427a36b9..4adfcdcbbe5270d628df553fb00afd6219b449e9 100644 (file)
--- a/Utility/LogFile.hs
+++ b/Utility/LogFile.hs
@@ -35,7 +35,7 @@ rotateLog logfile = go 0
   where
        go num
                | num > maxLogs = return ()
-               | otherwise = whenM (doesFileExist currfile) $ do
+               | otherwise = whenM (doesFileExist (toOsPath currfile)) $ do
                        go (num + 1)
                        rename (toRawFilePath currfile) (toRawFilePath nextfile)
          where
@@ -50,7 +50,7 @@ rotatedLog logfile n = logfile ++ "." ++ show n
 
 {- Lists most recent logs last. -}
 listLogs :: FilePath -> IO [FilePath]
-listLogs logfile = filterM doesFileExist $ reverse $ 
+listLogs logfile = filterM (doesFileExist . toOsPath) $ reverse $ 
        logfile : map (rotatedLog logfile) [1..maxLogs]
 
 maxLogs :: Int

diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs
index e8569ee0238d93fcd1da5323cf4df9de4bb0d809..7864b045b44ef630b1f4c4e781fca969ed7d0f97 100644 (file)
--- a/Utility/Lsof.hs
+++ b/Utility/Lsof.hs
@@ -15,6 +15,7 @@ module Utility.Lsof (
 import Common
 import BuildInfo
 import Utility.Env.Set
+import qualified Utility.OsString as OS
 
 import System.Posix.Types
 
@@ -30,12 +31,14 @@ data ProcessInfo = ProcessInfo ProcessID CmdLine
  - path where the program was found. Make sure at runtime that lsof is
  - available, and if it's not in PATH, adjust PATH to contain it. -}
 setup :: IO ()
-setup = do
-       let cmd = fromMaybe "lsof" BuildInfo.lsof
-       when (isAbsolute cmd) $ do
-               path <- getSearchPath
-               let path' = takeDirectory cmd : path
-               setEnv "PATH" (intercalate [searchPathSeparator] path') True
+setup = when (isAbsolute cmd) $ do
+       path <- getSearchPath
+       let path' = fromOsPath $ OS.intercalate sep $
+               takeDirectory cmd : path
+       setEnv "PATH" path' True
+  where
+       cmd = toOsPath $ fromMaybe "lsof" BuildInfo.lsof
+       sep = OS.singleton searchPathSeparator
 
 {- Checks each of the files in a directory to find open files.
  - Note that this will find hard links to files elsewhere that are open. -}

diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 0b7097b7321379277ba14e08b5a3acd0dc93cd25..9785cf692eb16371610d908d41164eb4fd14fbcb 100644 (file)
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -227,7 +227,7 @@ defaultChunkSize = 32 * k - chunkOverhead
  -}
 watchFileSize
        :: (MonadIO m, MonadMask m)
-       => RawFilePath
+       => OsPath
        -> MeterUpdate
        -> (MeterUpdate -> m a)
        -> m a

diff --git a/Utility/Url.hs b/Utility/Url.hs
index dbe464752789ed2eff07e50a2b668d26d03ea248..9100d80711d298cde87bd7b9681f6f546e8bc978 100644 (file)
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -50,6 +50,7 @@ import Utility.IPAddress
 import qualified Utility.RawFilePath as R
 import Utility.Hash (IncrementalVerifier(..))
 import Utility.Url.Parse
+import qualified Utility.FileIO as F
 
 import Network.URI
 import Network.HTTP.Types
@@ -311,8 +312,8 @@ getUrlInfo url uo = case parseURIRelaxed url of
                =<< curlRestrictedParams r u defport (basecurlparams url')
 
        existsfile u = do
-               let f = toRawFilePath (unEscapeString (uriPath u))
-               s <- catchMaybeIO $ R.getSymbolicLinkStatus f
+               let f = toOsPath (unEscapeString (uriPath u))
+               s <- catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath f)
                case s of
                        Just stat -> do
                                sz <- getFileSize' f stat
@@ -362,10 +363,10 @@ headRequest r = r
  -
  - When the download fails, returns an error message.
  -}
-download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())
+download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ())
 download = download' False
 
-download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())
+download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ())
 download' nocurlerror meterupdate iv url file uo =
        catchJust matchHttpException go showhttpexception
                `catchNonAsync` (dlfailed . show)
@@ -421,8 +422,8 @@ download' nocurlerror meterupdate iv url file uo =
                -- curl does not create destination file
                -- if the url happens to be empty, so pre-create.
                unlessM (doesFileExist file) $
-                       writeFile file ""
-               ifM (boolSystem "curl" (curlparams ++ [Param "-o", File file, File rawurl]))
+                       F.writeFile file mempty
+               ifM (boolSystem "curl" (curlparams ++ [Param "-o", File (fromOsPath file), File rawurl]))
                        ( return $ Right ()
                        , return $ Left "download failed"
                        )
@@ -434,7 +435,7 @@ download' nocurlerror meterupdate iv url file uo =
                noverification
                let src = unEscapeString (uriPath u)
                withMeteredFile src meterupdate $
-                       L.writeFile file
+                       F.writeFile file
                return $ Right ()
 
        -- Conduit does not support ftp, so will throw an exception on a
@@ -461,9 +462,9 @@ download' nocurlerror meterupdate iv url file uo =
  - thrown for reasons other than http status codes will still be thrown
  - as usual.)
  -}
-downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> FilePath -> UrlOptions -> IO ()
+downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> OsPath -> UrlOptions -> IO ()
 downloadConduit meterupdate iv req file uo =
-       catchMaybeIO (getFileSize (toRawFilePath file)) >>= \case
+       catchMaybeIO (getFileSize file) >>= \case
                Just sz | sz > 0 -> resumedownload sz
                _ -> join $ runResourceT $ do
                        liftIO $ debug "Utility.Url" (show req')
@@ -566,7 +567,7 @@ sinkResponseFile
        => MeterUpdate
        -> Maybe IncrementalVerifier
        -> BytesProcessed
-       -> FilePath
+       -> OsPath
        -> IOMode
        -> Response (ConduitM () B8.ByteString m ())
        -> m ()
@@ -577,7 +578,7 @@ sinkResponseFile meterupdate iv initialp file mode resp = do
                        return (const noop)
                (Just iv', _) -> return (updateIncrementalVerifier iv')
                (Nothing, _) -> return (const noop)
-       (fr, fh) <- allocate (openBinaryFile file mode) hClose
+       (fr, fh) <- allocate (F.openBinaryFile file mode) hClose
        runConduit $ responseBody resp .| go ui initialp fh
        release fr
   where

diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn
index 6268d931643858623fb4fdd15c92c5eefc71e9f6..3676495fd6b763e7d29f6427f9d8ab2a6889d700 100644 (file)
--- a/doc/todo/RawFilePath_conversion.mdwn
+++ b/doc/todo/RawFilePath_conversion.mdwn
@@ -26,6 +26,18 @@ status.
   Make Utility.SystemDirectory import it when built with OsPath,
   and the remaining 6 hours or work will explain itself..
   This has been started in the `ospath` branch.
+* As part of the OsPath conversion, Git.LsFiles has several
+  `pipeNullSplit'` calls that have toOsPath mapped over the results.
+  That adds an additional copy, so the lazy ByteString is converted to strict,
+  and then to ShortByteString, with a copy each time. This is in the
+  critical path for large git repos, and might be a noticable slowdown.
+  There is currently no easy way to go direct from a lazy ByteString to a
+  ShortByteString, although it would certianly be possible to write low
+  level code to do it efficiently. Alternatively, it would be possible to
+  read a strict ByteString direct from a handle, like hGetLine does
+  (although in this case it would need to stop at the terminating 0 byte)
+  and unsafePerformIO to stream to a list would avoid needing to rewrite
+  this code to not use a list.
 
 [[!tag confirmed]]